home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / fibcomp.amos / fibcomp.amosSourceCode
AMOS Source Code  |  1997-01-31  |  2KB  |  97 lines
  1. 'this program will compact an 8 bit sample using fibonacci compression 
  2.  
  3. Dim F(15),DIFF(512)
  4.  
  5. F(0)=-34
  6. F(1)=-21
  7. F(2)=-13
  8. F(3)=-8
  9. F(4)=-5
  10. F(5)=-3
  11. F(6)=-2
  12. F(7)=-1
  13. F(8)=0
  14. F(9)=1
  15. F(10)=2
  16. F(11)=3
  17. F(12)=5
  18. F(13)=8
  19. F(14)=13
  20. F(15)=21
  21.  
  22. For N=-256 To 256
  23.    D=Abs(F(0)-N) : F=0
  24.    For FF=1 To 15
  25.       If Abs(F(FF)-N)<D
  26.          D=Abs(F(FF)-N)
  27.          F=FF
  28.       End If 
  29.    Next 
  30.    DIFF(N+256)=F
  31. Next 
  32.  
  33. Repeat 
  34.    F$=Fsel$("","","Please select a sample to compress")
  35.    If Exist(F$)
  36.       Reserve As Work 10, Extension_18_0294(F$)
  37.       Reserve As Work 11,Length(10)
  38.       Bload F$,10
  39.       If Instr(F$,"/")
  40.          D$=Left$(F$, Extension_18_0086(F$,"/"))
  41.          FF$=Mid$(F$, Extension_18_0086(F$,"/")+1)
  42.       Else 
  43.          D$=Left$(F$, Extension_18_0086(F$,":"))
  44.          FF$=Mid$(F$, Extension_18_0086(F$,":")+1)
  45.       End If 
  46.       If Peek$(Start(10),4)="FORM"
  47.          A=Hunt(Start(10) To Start(10)+Length(10),"BODY")+8
  48.       Else 
  49.          A=Start(10)
  50.       End If 
  51.       B=Start(11)
  52.       'store initial value 
  53.       MYPEEK[A] : V=Param : Inc A
  54.       Poke B,V : Inc B
  55.       Repeat 
  56.          MYPEEK[A] : NV=Param : Inc A
  57.          DV=Min(Max(0,256+NV-V),512)
  58.          Poke B,DIFF(DV) : Inc B
  59.          V=V+F(DIFF(DV))
  60.       Until A=Start(10)+Length(10)
  61.       Reserve As Chip Work 12,Length(11)
  62.       'decompress the sample back into a bank to make sure it works
  63.       B=Start(12)
  64.       MYPEEK[Start(11)] : V=Param
  65.       For A=Start(11)+1 To Start(11)+Length(11)-1
  66.          Poke B,V : Inc B
  67.          MYPEEK[A] : D=Param
  68.          V=V+F(D)
  69.       Next 
  70.       Sam Raw 3,Start(12),Length(12),8000
  71.       'meanwhile, compress the data down into two nibbles per byte 
  72.       Reserve As Work 13,Length(11)+80
  73.       B=Start(13)
  74.       Poke$ B,"CSFX" : Add B,4
  75.       Loke B,Length(12) : Add B,4
  76.       Poke B,Peek(Start(11)) : Inc B
  77.       For A=Start(11)+1 To Start(11)+Length(11)-1 Step 2
  78.          D1=Peek(A)*16
  79.          D2=Peek(A+1)
  80.          D=D1 or D2
  81.          Poke B,D : Inc B
  82.       Next 
  83.       NF$=FF$+".fib"
  84.       Bsave NF$,Start(13) To B
  85.       Erase 10
  86.       Erase 11
  87.    End If 
  88. Until F$=""
  89.  
  90. Edit 
  91.  
  92. Procedure MYPEEK[A]
  93.    D=Peek(A)
  94.    If Btst(7,D)
  95.       D=D or $FFFFFF00
  96.    End If 
  97. End Proc[D]